home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / energize / energize-menus.el < prev    next >
Encoding:
Text File  |  1995-03-21  |  43.1 KB  |  1,208 lines
  1. ;;; -*- Mode:Emacs-Lisp -*-
  2. ;;; Copyright (C) 1992, 1993, 1994 by Lucid, Inc.  All Rights Reserved.
  3. ;;; Copyright (C) 1995 by INS Engineering.
  4.  
  5. ;;; The names of the menu items (as emacs sees them) are short and ugly.
  6. ;;; These are the names by which the Energize protocol knows the commands.
  7. ;;; The menu items are made to display in a more human-friendly way via the
  8. ;;; X resource database, which is expected to contain entries like
  9. ;;;
  10. ;;;    *buildanddebug.labelString:    Build and Debug
  11. ;;;
  12. ;;; in the Emacs app-defaults file.
  13. ;;;
  14. ;;; We need to map these short Energize-names to the functions which invoke
  15. ;;; them; we do this via the energize-menu-item-table, which is an obarray
  16. ;;; hash table associating the names with the functions.  We do the reverse
  17. ;;; association via an 'energize-name property on the function's name symbol.
  18. ;;;
  19. ;;; Sometimes the short ugly names show up in error messages; probably we
  20. ;;; should read the resource database to get the pretty names.
  21.  
  22. (require 'menubar)
  23.  
  24. (defvar sc-mode nil)        ; just so it has a value even if not loaded
  25. (defvar font-lock-mode nil)    ; likewise
  26.  
  27. (defconst energize-menu-item-table (make-vector 511 nil)
  28.   "obarray used for fast mapping of symbolic energize request-names to the 
  29. functions that invoke them.")
  30.  
  31. (defvar energize-default-menu-state ()
  32.   "List of the Energize menu items associated with every buffers.")
  33.  
  34. (defvar energize-menu-state ()
  35.   "Buffer local variable listing the menu items associated with a buffer.")
  36.  
  37. ;; When it is made local, don't kill it when kill-all-local-variables is
  38. ;; called (as from the major mode via revert-buffer) or else we tend to lose
  39. ;; the information, as the ProposeChoicesRequest comes in at an inopportune
  40. ;; time.
  41. (put 'energize-menu-state 'permanent-local t)
  42.  
  43. ;;; Hook to update the menu state when the kernel tells us it changed
  44.  
  45. (defun energize-update-menu-state (items)
  46.   (let ((buffer (car items))
  47.     (previous-buffer (current-buffer)))
  48.     (if (null buffer)
  49.     (setq energize-default-menu-state items)
  50.       (unwind-protect
  51.       (progn
  52.         (set-buffer buffer)
  53.         (setq energize-menu-state items))
  54.     (set-buffer previous-buffer)))))
  55.  
  56. (setq energize-menu-update-hook 'energize-update-menu-state)
  57.  
  58. ;;; The energize-with-timeout macro is used to show to the user that we are 
  59. ;;; waiting for a reply from the energize kernel when it is too slow.
  60.  
  61. (defvar initial-energize-timeout-state
  62.   (let ((l '("." ".." "..." "...." "....." "......" "......." "........")))
  63.     (nconc l l)))
  64.  
  65. (defvar energize-timeout-state initial-energize-timeout-state)
  66.  
  67. (defun energize-warn-kernel-slow (pair)
  68.   (setq energize-timeout-state (cdr energize-timeout-state))
  69.   (message "%s Type %c to cancel%s"
  70.        (car pair) (quit-char) (car energize-timeout-state))
  71.   (rplacd pair t))
  72.  
  73. (defmacro energize-with-timeout (notice &rest body)
  74.   (list 'let* (list
  75.            (list 'timeout-pair (list 'cons notice nil))
  76.            '(timeout (add-timeout 1.5 'energize-warn-kernel-slow
  77.                       timeout-pair 1.5)))
  78.     (list 'unwind-protect (cons 'progn body)
  79.           '(disable-timeout timeout)
  80.           '(setq energize-timeout-state initial-energize-timeout-state)
  81.           '(if (cdr timeout-pair) (message "")))))
  82.  
  83. (defun energize-def-menu-item (name function &optional dont-define)
  84.   ;; function->name mapping is on the function name's plist
  85.   ;; name->function mapping is via an obarray
  86.   ;; dont-define means it already has a function definition
  87.   (put function 'energize-name (purecopy name))
  88.   (set (intern name energize-menu-item-table) function)
  89.   ;; Define the (trivial) function
  90.   ;; It's ok that this function is interpreted, because it contains only
  91.   ;; one function call with constant args, so it's just as fast as it would
  92.   ;; be if it were byte-coded.
  93.   (if (not dont-define)
  94.       (fset function
  95.         (purecopy
  96.          (` (lambda ()
  97.           (, (format "Executes the Energize \"%s\" command." name))
  98.           (interactive)
  99.           (energize-execute-command (, name)))))))
  100.   ;; Return the menu-item descriptor.
  101.   (vector (purecopy name) function nil nil))
  102.  
  103. (defmacro energize-def-menu (menu-name &rest items)
  104.   (` (list (, menu-name)
  105.        (,@ (mapcar
  106.         '(lambda (x)
  107.            (if (and (consp x) (stringp (car x)))
  108.                (cons 'energize-def-menu-item
  109.                  (mapcar '(lambda (xx)
  110.                     (if (stringp xx)
  111.                         (purecopy xx)
  112.                       (list 'quote xx)))
  113.                      x))
  114.              x))
  115.         items)))))
  116.  
  117. (put 'energize-def-menu 'lisp-indent-function 1)
  118.  
  119.  
  120. ;; If menubar-religion is 'winning, the menubar looks like jwz likes it.
  121. ;; If menubar-religion is 'losing, the menubar looks like Gareth and the
  122. ;; documentation folks like it.  See also menubar.el - it consults this
  123. ;; variable for the layout of the File menu which is inherited here.
  124.  
  125. (defconst energize-menubar
  126.  (purecopy-menubar
  127.   (list
  128.    ["sheet" energize-toggle-psheet nil]
  129.  
  130.    ;; Perform some surgery on the default File menu to insert our items.
  131.    ;; This is to avoid having to duplicate it here...  Don't try this at
  132.    ;; home, kids!
  133. ;;;   (let* ((file (copy-sequence
  134. ;;;                 (car (find-menu-item default-menubar '("File")))))
  135. ;;;          (print (car (find-menu-item file '("Print Buffer"))))
  136. ;;;          (exit  (car (find-menu-item file '("Exit XEmacs"))))
  137. ;;;          (print-cons (memq print file))
  138. ;;;          (exit-cons  (memq exit file))
  139. ;;;          )
  140. ;;;     ;; Insert "Print Annotated" just after "Print"
  141. ;;;     (setcdr print-cons (cons '["Print Annotated Buffer"
  142. ;;;                                energize-annotate-print-ps
  143. ;;;                                t]
  144. ;;;                              (cdr print-cons)))
  145. ;;;
  146. ;;;     ;; Insert "Checkpoint" and "Shutdown" just before "Exit XEmacs".
  147. ;;;     (setcar exit-cons ["Connect to Energize" energize-menu-connect-directly
  148. ;;;                         (not (connected-to-energize-p))])
  149. ;;;     (setcdr exit-cons
  150. ;;;             (nconc
  151. ;;;              (list (energize-def-menu-item "checkpoint"
  152. ;;;                                            'energize-checkpoint-database)
  153. ;;;                    ["Disconnect from Energize" disconnect-from-energize
  154. ;;;                     (connected-to-energize-p)]
  155. ;;;                    "----"
  156. ;;;                    (energize-def-menu-item "energizeShutdownServer"
  157. ;;;                                            'energize-kill-server)
  158. ;;;                    )
  159. ;;;              (if (not (eq menubar-religion 'winning))
  160. ;;;                  (list "----"))
  161. ;;;              (list exit)))
  162. ;;;     file)
  163.    ;; this is the losing menubar-religion...
  164.    (` ("File"
  165.        ["New Frame" make-frame t]
  166.        ["Open..." find-file t]
  167.        ["Save" save-buffer nil "menubar.el"]
  168.        ["Save As..." write-file t]
  169.        ["Save Some Buffers" save-some-buffers t]
  170.        "------"
  171.        ["Insert File..." insert-file t]
  172.        "-----"
  173.        ["Print Buffer" lpr-buffer t nil]
  174.        ["Print Annotated Buffer" energize-annotate-print-ps t]
  175.        "-----"
  176.        ["Delete Frame" delete-frame t]
  177.        ["Kill Buffer" kill-this-buffer t nil]
  178.        ["Revert Buffer" revert-buffer t nil]
  179.        "-----"
  180.        ("Compare"
  181.     ["Two Files ..."            ediff-files              t]
  182.     ["Two Buffers ..."    ediff-buffers         t]
  183.     ["Three Files ..."    ediff-files3         t]
  184.     ["Three Buffers ..."    ediff-buffers3         t]
  185.     ["Windows ..."        ediff-windows         t]
  186.     ["Small Regions ..."    ediff-small-regions     t]
  187.     ["Large Regions ..."    ediff-large-regions     t]
  188.     ["File with Revision ..." ediff-revision         t])
  189.        ("Merge"
  190.     ["Files ..."             ediff-merge-files        t]
  191.     ["Files with Ancestor ..." ediff-merge-files-with-ancestor t]
  192.     ["Buffers ..."            ediff-merge-buffers      t]
  193.     ["Buffers with Ancestor ..." ediff-merge-buffers-with-ancestor t]
  194.     ["Revisions ..."        ediff-merge-revisions    t]
  195.     ["Revisions with Ancestor ..." ediff-merge-revisions-with-ancestor t]
  196.     )
  197.        ("Apply Patch"
  198.     ["To a file ..."            ediff-patch-file         t]
  199.     ["To a buffer ..."    ediff-patch-buffer     t])
  200.        "-----"
  201.        ["Connect to Energize" energize-menu-connect-directly
  202.     (not (connected-to-energize-p))]
  203.        (, (energize-def-menu-item "checkpoint" 'energize-checkpoint-database))
  204.        ["Disconnect from Energize" disconnect-from-energize
  205.     (connected-to-energize-p)]
  206.        "----"
  207.        (, (energize-def-menu-item "energizeShutdownServer" 'energize-kill-server))
  208.        "----"
  209.        ["Exit XEmacs" save-buffers-kill-emacs t]))
  210.  
  211.    ;; Energize also adds some menu items to the middle of the "Edit" menu.
  212.    ;; Someday these should be moved to the default menubar, maybe, once it's
  213.    ;; easier to define `energize-search' in a non-Energize world.
  214.    (let* ((edit (copy-sequence
  215.          (car (find-menu-item default-menubar '("Edit")))))
  216.       (clear (car (find-menu-item edit '("Clear"))))
  217.       (clear-cons (memq clear edit))
  218.       )
  219.      ;; Insert these just after "Clear"
  220.      (setcdr clear-cons
  221.          (append '("-----"
  222.                ["Search and Replace..." energize-search t]
  223.                ["Search Selection Forward" ow-find
  224.             (or ow-find-last-string (x-selection-owner-p))]
  225.                ["Search Selection Backward" ow-find-backward
  226.             (or ow-find-last-string (x-selection-owner-p))]
  227.                )
  228.              (cdr clear-cons)))
  229.      edit)
  230.  
  231.     (energize-def-menu "Browse" 
  232.      ["editdef" energize-edit-definition t]
  233.      ("editdec" energize-edit-declaration-dbox)
  234.      ("calltreebrowser" energize-browse-tree)
  235.      ("classbrowser" energize-browse-class)
  236.      ("lebrowser" energize-browse-language-elt)
  237.      ("includers" energize-where-included)
  238.      "-----" 
  239.  
  240.      ;; Make Energize control the selectability of these, but don't define
  241.      ;; the functions here (they are defined in lisp, not as aliases for
  242.      ;; an Energize command.)
  243.  
  244.      ;; No, this doesn't seem to work. Energize disowns all knowledge.
  245.      ["visituse" energize-next-use-start (connected-to-energize-p)]
  246.      ["nextuse" energize-next-use-command (connected-to-energize-p)]
  247.      "-----" 
  248.      ["List History" energize-history (connected-to-energize-p)]
  249.      ["Step Back in History" energize-history-previous (connected-to-energize-p)]
  250.      "-----"
  251.      ("energize" energize-pop-to-energize-buffer)
  252.      ("showsystemlog"    energize-browse-system-log)
  253.      ("errorbrowser" energize-browse-error)
  254.      "-----"
  255.      ("toolstatus"    energize-browse-toolstat)
  256.      ["Shell" shell t]
  257.      )
  258.  
  259.  (if (eq menubar-religion 'winning)
  260.  
  261.     (list
  262.      ;; Winning
  263.      "Options"
  264.      (energize-def-menu-item "debuggerpanel" 'energize-show-debugger-panel)
  265.      "------"
  266.      ["Read Only" toggle-read-only :style toggle :selected buffer-read-only]
  267.      ["Case Sensitive Search" (setq case-fold-search (not case-fold-search))
  268.       :style toggle :selected (not case-fold-search)]
  269.      ["Case Sensitive Replace" (setq case-replace (not case-replace))
  270.       :style toggle :selected (not case-replace)]
  271.      ["Overstrike" overwrite-mode :style toggle :selected overwrite-mode]
  272.      ["Auto Delete Selection" (if (memq 'pending-delete-pre-hook
  273.                     pre-command-hook)
  274.                   (pending-delete-off nil)
  275.                 (pending-delete-on nil))
  276.       :style toggle :selected (memq 'pending-delete-pre-hook pre-command-hook)]
  277.      ["Teach Extended Commands" (setq teach-extended-commands-p
  278.                       (not teach-extended-commands-p))
  279.       :style toggle :selected teach-extended-commands-p]
  280.      ["Debug On Error" (setq debug-on-error (not debug-on-error))
  281.       :style toggle :selected debug-on-error]
  282. ;     ["Line Numbers" (line-number-mode nil)
  283. ;      :style toggle :selected line-number-mode]
  284.      (append '("Syntax Highlighting" 
  285.        ["None" (font-lock-mode 0) :style radio :selected (null font-lock-mode)])
  286.          (and (not (string-match "Widec" emacs-version))
  287.           (list ["Fonts" (progn (require 'font-lock)
  288.                (font-lock-use-default-fonts)
  289.                (font-lock-mode 1))
  290.        :style radio
  291.        :selected (and font-lock-mode
  292.               (equal (find-face 'italic)  ; kind of a kludge...
  293.                  (find-face 'font-lock-comment-face)))]))
  294.          '(
  295.       ["Colors" (progn (require 'font-lock)
  296.                (font-lock-use-default-colors)
  297.                (font-lock-mode 1))
  298.        :style radio
  299.        :selected (and font-lock-mode
  300.               (not (equal (find-face 'italic)
  301.                   (find-face 'font-lock-comment-face))))]
  302.       "-----"
  303.       ["Less" (progn (require 'font-lock)
  304.              (font-lock-use-default-minimal-decoration)
  305.              (font-lock-mode 0)
  306.              (font-lock-mode 1))
  307.        :style radio
  308.        :selected (and font-lock-mode
  309.               (eq c++-font-lock-keywords c-font-lock-keywords-1))]
  310.       ["More" (progn (require 'font-lock)
  311.              (font-lock-use-default-maximal-decoration)
  312.              (font-lock-mode 0)
  313.              (font-lock-mode 1))
  314.        :style radio
  315.        :selected (and font-lock-mode
  316.               (eq c++-font-lock-keywords c-font-lock-keywords-2))]
  317.       "-----"
  318.       ["Fast" (progn (require 'fast-lock)
  319.              (if fast-lock-mode
  320.              (progn
  321.                (fast-lock-mode 0)
  322.                ;; this shouldn't be necessary so there has to
  323.                ;; be a redisplay bug lurking somewhere (or
  324.                ;; possibly another event handler bug)
  325.                (force-mode-line-update))
  326.                (if font-lock-mode
  327.                (progn
  328.                  (fast-lock-mode 1)
  329.                  (force-mode-line-update)))))
  330.        :active font-lock-mode
  331.        :style toggle
  332.        :selected fast-lock-mode]
  333.       ))
  334.      '("Paren Highlighting"
  335.        ["None" (paren-set-mode -1)
  336.     :style radio :selected (not paren-mode)]
  337.        ["Blinking Paren" (paren-set-mode 'blink-paren)
  338.     :style radio :selected (eq paren-mode 'blink-paren)]
  339.        ["Steady Paren" (paren-set-mode 'paren)
  340.     :style radio :selected (eq paren-mode 'paren)]
  341.        ["Expression" (paren-set-mode 'sexp)
  342.     :style radio :selected (eq paren-mode 'sexp)]
  343.        ["Nested Shading" (paren-set-mode 'nested)
  344.     :style radio :selected (eq paren-mode 'nested) :enabled nil]
  345.        )
  346.      "------"
  347.      '("Font"    "initialized later")
  348.      '("Size"    "initialized later")
  349.      '("Weight"    "initialized later")
  350.      ["Edit faces" edit-faces t]
  351.      "-----"
  352.      ["Energize Edit Modes..." energize-set-edit-modes t]
  353.      (energize-def-menu-item "setprojectdisplay"
  354.                  'energize-set-project-display)
  355.      (list "Target Display"
  356.        (energize-def-menu-item "fulltargets"
  357.                    'energize-full-targets)
  358.        (energize-def-menu-item "abbreviatetargets"
  359.                    'energize-abbreviate-targets))
  360.      '("Source Control"
  361.        ["None" (sc-mode nil)   :style radio :selected (eq sc-mode nil)]
  362.        ["SCCS" (sc-mode 'SCCS) :style radio :selected (eq sc-mode 'SCCS)]
  363.        ["RCS"  (sc-mode 'RCS)  :style radio :selected (eq sc-mode 'RCS)]
  364.        ["CVS"  (sc-mode 'CVS)  :style radio :selected (eq sc-mode 'CVS)]
  365.        ["ClearCase" (sc-mode 'CCASE):style radio :selected (eq sc-mode 'CCASE)]
  366.        )
  367.      "-----"
  368.      ["Buffers Menu Length..."
  369.       (progn
  370.     (setq buffers-menu-max-size
  371.           (read-number
  372.            "Enter number of buffers to display (or 0 for unlimited): "))
  373.     (if (eq buffers-menu-max-size 0) (setq buffers-menu-max-size nil)))
  374.       t]
  375.      ["Buffers Sub-Menus" (setq complex-buffers-menu-p
  376.                 (not complex-buffers-menu-p))
  377.       :style toggle :selected complex-buffers-menu-p]
  378.      "-----"
  379.      ["Save Options" save-options-menu-settings t]
  380.      )
  381.  
  382.     (list
  383.      ;; Non-winning
  384.      "Options" 
  385.      ["Split Screen"        split-window-vertically t]
  386.      ["Unsplit"            delete-other-windows    t]
  387.      "------"
  388.      (energize-def-menu-item "debuggerpanel" 'energize-show-debugger-panel)
  389.      "------"
  390.      ["Read Only" toggle-read-only :style toggle :selected buffer-read-only]
  391.      ["Overstrike " overwrite-mode :style toggle :selected overwrite-mode]
  392.      ["Auto Delete Selection" (if (memq 'pending-delete-pre-hook
  393.                     pre-command-hook)
  394.                   (pending-delete-off nil)
  395.                 (pending-delete-on nil))
  396.       :style toggle :selected (memq 'pending-delete-pre-hook pre-command-hook)]
  397.      ["Teach Extended" (setq teach-extended-commands-p
  398.                  (not teach-extended-commands-p))
  399.       :style toggle :selected teach-extended-commands-p]
  400.      "------"
  401.      '("Font"    "initialized later")
  402.      '("Size"    "initialized later")
  403.      '("Weight"    "initialized later")
  404.      "------"
  405.      (append '("Syntax Highlighting" 
  406.        ["None" (font-lock-mode 0) :style radio :selected (null font-lock-mode)])
  407.          (and (not (string-match "Widec" emacs-version))
  408.           (list ["Fonts" (progn (require 'font-lock)
  409.                (font-lock-use-default-fonts)
  410.                (font-lock-mode 1))
  411.        :style radio
  412.        :selected (and font-lock-mode
  413.               (equal (find-face 'italic)  ; kind of a kludge...
  414.                  (find-face 'font-lock-comment-face)))]))
  415.          '(
  416.       ["Colors" (progn (require 'font-lock)
  417.                (font-lock-use-default-colors)
  418.                (font-lock-mode 1))
  419.        :style radio
  420.        :selected (and font-lock-mode
  421.               (not (equal (find-face 'italic)
  422.                   (find-face 'font-lock-comment-face))))]
  423.       "-----"
  424.       ["Less" (progn (require 'font-lock)
  425.              (font-lock-use-default-minimal-decoration)
  426.              (font-lock-mode 0)
  427.              (font-lock-mode 1))
  428.        :style radio
  429.        :selected (and font-lock-mode
  430.               (eq c++-font-lock-keywords c-font-lock-keywords-1))]
  431.       ["More" (progn (require 'font-lock)
  432.              (font-lock-use-default-maximal-decoration)
  433.              (font-lock-mode 0)
  434.              (font-lock-mode 1))
  435.        :style radio
  436.        :selected (and font-lock-mode
  437.               (eq c++-font-lock-keywords c-font-lock-keywords-2))]
  438.       "-----"
  439.       ["Fast" (progn (require 'fast-lock)
  440.              (if fast-lock-mode
  441.              (progn
  442.                (fast-lock-mode 0)
  443.                ;; this shouldn't be necessary so there has to
  444.                ;; be a redisplay bug lurking somewhere (or
  445.                ;; possibly another event handler bug)
  446.                (force-mode-line-update))
  447.                (if font-lock-mode
  448.                (progn
  449.                  (fast-lock-mode 1)
  450.                  (force-mode-line-update)))))
  451.        :active font-lock-mode
  452.        :style toggle
  453.        :selected fast-lock-mode]
  454.       ))
  455.  
  456.      '("Paren Highlighting"
  457.        ["None" (blink-paren 0)
  458.     :style radio
  459.     :selected (not (memq 'blink-paren-pre-command pre-command-hook))]
  460.        ["Blink" (progn
  461.           (setq highlight-paren-expression nil)
  462.           (blink-paren 1))
  463.     :style radio
  464.     :selected (and (not highlight-paren-expression)
  465.                (memq 'blink-paren-pre-command pre-command-hook))]
  466.        ["Highlight" (progn
  467.               (setq highlight-paren-expression t)
  468.               (blink-paren 1))
  469.     :style radio
  470.     :selected (and highlight-paren-expression
  471.                (memq 'blink-paren-pre-command pre-command-hook))]
  472.        )
  473.      "-----"
  474.      ["Energize Edit Modes..." energize-set-edit-modes t]
  475.      (energize-def-menu-item "setprojectdisplay"
  476.                  'energize-set-project-display)
  477.      (list "Target Display"
  478.        (energize-def-menu-item "fulltargets"
  479.                    'energize-full-targets)
  480.        (energize-def-menu-item "abbreviatetargets"
  481.                    'energize-abbreviate-targets))
  482.      "-----"
  483.      ["Buffers Length..."
  484.       (progn
  485.     (setq buffers-menu-max-size
  486.           (read-number
  487.            "Enter number of buffers to display (or 0 for unlimited): "))
  488.     (if (eq buffers-menu-max-size 0) (setq buffers-menu-max-size nil)))
  489.       t]
  490.      ["Buffers Menus" (setq complex-buffers-menu-p
  491.                 (not complex-buffers-menu-p))
  492.       :style toggle :selected complex-buffers-menu-p]
  493.      "-----"
  494.      '("Source Control"
  495.        ["None" (sc-mode nil)   :style radio :selected (eq sc-mode nil)]
  496.        ["SCCS" (sc-mode 'SCCS) :style radio :selected (eq sc-mode 'SCCS)]
  497.        ["RCS"  (sc-mode 'RCS)  :style radio :selected (eq sc-mode 'RCS)]
  498.        ["CVS"  (sc-mode 'CVS)  :style radio :selected (eq sc-mode 'CVS)]
  499.        ["ClearCase" (sc-mode 'CCASE):style radio :selected (eq sc-mode 'CCASE)]
  500.        )
  501.      "-----"
  502.      ["Save Options" save-options-menu-settings t]
  503.      )
  504.        
  505.     )
  506.  
  507.  (if (eq menubar-religion 'winning)
  508.  
  509.    (energize-def-menu "Debug"
  510.      ;; Winning
  511.      ("debugprogram"    energize-debug-target)
  512.      ("runprogram"    energize-run-target)
  513.      "-----"
  514.      ;; Make Energize control the selectability of the setbreakpoint item, but
  515.      ;; don't define the function here (it just runs the existing gdb-break
  516.      ;; command, which is advised to hack Energize.)
  517.      ("setbreakpoint"    gdb-break t)
  518.      ("breaklist"    energize-list-breakpoints)
  519.      "-----"
  520.      ["Next Error" next-error t]
  521.      ["Previous Error" previous-error
  522.       :keys "\\[universal-argument] \\[next-error]"]
  523.      ("errorbrowser" energize-browse-error)
  524.      ("clearerrorlog" energize-clear-error-log)
  525.      ("cleardebuggerlog"    energize-clear-debugger-log)
  526.      "-----" 
  527.      ("closeprogram"    energize-debugger-kill-program)
  528.      ("quitdebugger"    energize-quit-debugger)
  529.      )
  530.  
  531.    (energize-def-menu "Debug"
  532.      ;; Non-winning
  533.      ("debugprogram"    energize-debug-target)
  534.      ("runprogram"    energize-run-target)
  535.      "-----"
  536.      ;; Make Energize control the selectability of the setbreakpoint item, but
  537.      ;; don't define the function here (it just runs the existing gdb-break
  538.      ;; command, which is advised to hack Energize.)
  539.      ("setbreakpoint"    gdb-break t)
  540.      "-----"
  541.      ("debuggerpanel"    energize-show-debugger-panel)
  542.      "-----"
  543.      ("breaklist"    energize-list-breakpoints)
  544.      ("cleardebuggerlog"    energize-clear-debugger-log)
  545.      "-----"
  546.      ("errorbrowser" energize-browse-error)
  547.      ("clearerrorlog" energize-clear-error-log)
  548.      "-----" 
  549.      ["Next Error" next-error t]
  550.      ["Previous Error" previous-error
  551.       :keys "\\[universal-argument] \\[next-error]"]
  552.      "-----"
  553.      ("closeprogram"    energize-debugger-kill-program)
  554.      "-----"
  555.      ("quitdebugger"    energize-quit-debugger)
  556.      )
  557.    )
  558.  
  559.  (if (eq menubar-religion 'winning)
  560.  
  561.    (energize-def-menu "Compile"
  562.      ;; Winning
  563.      ("buildatarget" energize-build-a-target)
  564.      ("custombuildatarget" energize-custom-build-a-target)
  565. ;; Matthieu believed that this could be done now; however it would seem that
  566. ;; it still can't. So out it goes for the time being.
  567. ;;     "-----" 
  568. ;;     ("Terminate Build"  energize-abort-build)
  569.      "-----"
  570.      ["Next Error" next-error t]
  571.      ["Previous Error" previous-error
  572.       :keys "\\[universal-argument] \\[next-error]"]
  573.      ("errorbrowser" energize-browse-error)
  574.      ("clearerrorlog" energize-clear-error-log)
  575.      "-----"
  576.      ("defaultcompile" energize-default-compile-file)
  577.      ("custombuildfile" energize-custom-build-file)
  578.      "-----" 
  579.      ("deleteallobjects" energize-delete-object-files)
  580.      )
  581.  
  582.    (energize-def-menu "Compile" 
  583.      ;; Non-winning
  584.      ("buildatarget" energize-build-a-target)
  585.      ("custombuildatarget" energize-custom-build-a-target)
  586.      "-----"
  587.      ("defaultcompile" energize-default-compile-file)
  588.      ("custombuildfile" energize-custom-build-file)
  589.      "-----"
  590.      ("errorbrowser" energize-browse-error)
  591.      ("clearerrorlog" energize-clear-error-log)
  592.      "-----" 
  593.      ["Next Error" next-error t]
  594.      ["Previous Error" previous-error
  595.       :keys "\\[universal-argument] \\[next-error]"]
  596. ;; Matthieu believed that this could be done now; however it would seem that
  597. ;; it still can't. So out it goes for the time being.
  598. ;;     "-----" 
  599. ;;     ("Terminate Build"  energize-abort-build)
  600.      "-----" 
  601.      ("deleteallobjects" energize-delete-object-files)
  602.      )
  603.    )
  604.  
  605.  (if (eq menubar-religion 'winning)
  606.  
  607.    (list "Project"
  608.      ;; Winning
  609.      (energize-def-menu-item "newproject" 'energize-new-project)
  610.      (energize-def-menu-item "findproject" 'energize-find-project)
  611.      ["Save Project" save-buffer (eq major-mode 'energize-project-mode)]
  612.      ["Current Project" energize-pop-to-project-buffer nil nil]
  613.      (energize-def-menu-item "energize" 'energize-pop-to-energize-buffer)
  614.      "-----"
  615.      '("addprojectentry"
  616.        ["addobjectfiletarget"    energize-insert-object-file-target
  617.                        (eq major-mode 'energize-project-mode)]
  618.        "-----"
  619.        ["addexecutabletarget"    energize-insert-executable-target
  620.                        (eq major-mode 'energize-project-mode)]
  621.        ["addlibrarytarget"    energize-insert-library-target
  622.                        (eq major-mode 'energize-project-mode)]
  623.        ["addcollectiontarget"    energize-insert-collection-target
  624.                 (eq major-mode 'energize-project-mode)]
  625.        "-----"
  626.        ["addtargettarget"    energize-insert-target-target
  627.                        (eq major-mode 'energize-project-mode)]
  628.        ["addfiletarget"        energize-insert-file-target
  629.                        (eq major-mode 'energize-project-mode)]
  630.        "-----"
  631.        ["addrule"        energize-insert-rule
  632.                             (eq major-mode 'energize-project-mode)]
  633.       )
  634.      (energize-def-menu-item "instrumentatarget" 'energize-instrument-a-target)
  635.      "-----"
  636.      (energize-def-menu-item "importproject" 'energize-import-project)
  637.      (energize-def-menu-item "importprojectlist" 'energize-import-project-list)
  638.      (energize-def-menu-item "writeprojectlist" 'energize-write-project-list)
  639.      "-----"
  640.      (energize-def-menu-item "setprojectdisplay"
  641.                  'energize-set-project-display)
  642.      (list "Target Display"
  643.        (energize-def-menu-item "fulltargets"
  644.                    'energize-full-targets)
  645.        (energize-def-menu-item "abbreviatetargets"
  646.                    'energize-abbreviate-targets))
  647.      "-----"
  648.      (energize-def-menu-item "revertproject"
  649.                  'energize-fully-revert-project-buffer)
  650.      )
  651.  
  652.    (list "Project"
  653.      ;; Non-winning
  654.      (energize-def-menu-item "newproject" 'energize-new-project)
  655.      (energize-def-menu-item "findproject" 'energize-find-project)
  656.      ["Save Project" save-buffer (eq major-mode 'energize-project-mode)]
  657.      "-----"
  658.      (energize-def-menu-item "energize" 'energize-pop-to-energize-buffer)
  659.      ["Current Project" energize-pop-to-project-buffer nil nil]
  660.      "-----"
  661.      ["New C/C++ File"        energize-insert-object-file-target
  662.                        (eq major-mode 'energize-project-mode)]
  663.      '("addprojectentry"
  664.        ["addobjectfiletarget"    energize-insert-object-file-target
  665.                        (eq major-mode 'energize-project-mode)]
  666.        "-----"
  667.        ["addexecutabletarget"    energize-insert-executable-target
  668.                        (eq major-mode 'energize-project-mode)]
  669.        ["addlibrarytarget"    energize-insert-library-target
  670.                        (eq major-mode 'energize-project-mode)]
  671.        ["addcollectiontarget"    energize-insert-collection-target
  672.                 (eq major-mode 'energize-project-mode)]
  673.        "-----"
  674.        ["addtargettarget"    energize-insert-target-target
  675.                        (eq major-mode 'energize-project-mode)]
  676.        ["addfiletarget"        energize-insert-file-target
  677.                        (eq major-mode 'energize-project-mode)]
  678.        "-----"
  679.        ["addrule"        energize-insert-rule
  680.                             (eq major-mode 'energize-project-mode)]
  681.       )
  682.      "-----"
  683.      (energize-def-menu-item "instrumentatarget" 'energize-instrument-a-target)
  684.      "-----"
  685.      (energize-def-menu-item "importproject" 'energize-import-project)
  686.      (energize-def-menu-item "importprojectlist" 'energize-import-project-list)
  687.      "-----"
  688.      (energize-def-menu-item "writeprojectlist" 'energize-write-project-list)
  689.      "-----"
  690.      (energize-def-menu-item "setprojectdisplay"
  691.                  'energize-set-project-display)
  692.      (list "Target Display"
  693.        (energize-def-menu-item "fulltargets"
  694.                    'energize-full-targets)
  695.        (energize-def-menu-item "abbreviatetargets"
  696.                    'energize-abbreviate-targets))
  697.      "-----"
  698.      (energize-def-menu-item "revertproject"
  699.                  'energize-fully-revert-project-buffer)
  700.      )
  701.    )
  702.  
  703.  
  704.     '("Buffers"    ["List All Buffers" list-buffers t]
  705.         "--!here"        ; anything after this will be nuked
  706.         )
  707.  
  708.     nil        ; the partition: menus after this are flushright
  709.  
  710.     ;; We don't make any changes to the Help menu.
  711.     ;; WelcomeMat requires one change: added separately though
  712.     (car (find-menu-item default-menubar '("Help")))
  713.     )))
  714.  
  715. ;; For this command, the menu name (the resource) is "currentproject"
  716. ;; but the Energize command is "project".  the Energize command is 
  717. ;; historical, and the resource name was changed so that the "Project"
  718. ;; menu and the "Project" menu item don't necessarily have to be the
  719. ;; same text.
  720. ;;
  721. (energize-def-menu-item "project" 'energize-pop-to-project-buffer)
  722.  
  723. ;; code for tighter integration with specific tools
  724.  
  725. (defun energize-menu-connect-directly ()
  726.   (interactive)
  727.   (connect-to-energize nil))
  728.  
  729. (defvar energize-instrument-menu-options nil
  730.   "List of menu items which are instruments for Energize targets")
  731.  
  732. (defun energize-define-instrumentatarget-using-tool (tool)
  733.   "Add a menu item (and function) supporting instrumenting a particular tool"
  734.   (let ((function (intern (concat "energize-instrumentatarget-using-" tool)))
  735.     (l energize-instrument-menu-options)
  736.     (name (if (equal tool "") "DBX Compatible" (capitalize tool))))
  737.     (add-menu-item '("Project") (cons name "")
  738.            function
  739.            '(connected-to-energize-p)
  740.            "instrumentatarget")
  741.     (add-hook 'energize-hack-popup-hook 'energize-hack-instruments-in-popup)
  742.     (while (and l (not (equal (car l) tool)))
  743.       (setq l (cdr l)))
  744.     (if (null l) (setq energize-instrument-menu-options
  745.                (cons tool energize-instrument-menu-options)))
  746.     (fset function
  747.       (` (lambda ()
  748.            (, (format "Instruments a target using \"%s\"" tool))
  749.            (interactive)
  750.            (energize-execute-command "instrumentatarget" nil
  751.                      (, tool) t))))))
  752.  
  753. (defun energize-hack-instruments-in-popup (ex m)
  754.   (let ((l (cdr m)))
  755.     (while l
  756.       (if (equal (aref (car l) 0) "instrument")
  757.       (let ((r energize-instrument-menu-options)
  758.         v)
  759.         (while r
  760.           (setq v (vconcat (car l)))
  761.           (let ((name
  762.              (if (equal (car r) "") "DBX Compatible"
  763.                (capitalize (car r)))))
  764.           (aset (car l) 0 name)) 
  765.           (aset (car l) 1 (intern (concat
  766.                        "energize-instrumentatarget-using-"
  767.                        (car r))))
  768.           (setcdr l (cons v (cdr l)))
  769.           (setq r (cdr r)))
  770.         (setq l nil))
  771.     (setq l (cdr l))))
  772.     m))
  773.  
  774. (defun energize-sensitize-instruments-hook ()
  775.   "Sensitize the menubar by adding the executable to any derived
  776. instrumented targets"
  777.   (condition-case nil ; in case Project menu doesn't exist
  778.       (let* ((l energize-instrument-menu-options)
  779.          (institem
  780.           (car (find-menu-item current-menubar
  781.                    '("Project" "instrumentatarget"))))
  782.          (exenable (aref institem 2))
  783.          (exname (aref institem 3))
  784.          item)
  785.     (while l
  786.       (let ((citem (if (equal (car l) "") "DBX Compatible" (car l))))
  787.         (setq item (car (find-menu-item current-menubar
  788.                         (list "Project" citem)))))
  789.       (aset item 2 exenable)
  790.       (aset item 3 exname)
  791.       (setq l (cdr l))))
  792.     (error nil)))
  793.  
  794. (defun energize-set-default-menubar ()
  795.   (set-menubar energize-menubar)
  796.   (add-hook 'activate-menubar-hook 'build-buffers-menu-hook)
  797.   (add-hook 'activate-menubar-hook 'sensitize-file-and-edit-menus-hook)
  798.   (add-hook 'activate-menubar-hook 'energize-sensitize-instruments-hook 't)
  799.   (setq buffers-menu-max-size 20)
  800.   (setq complex-buffers-menu-p nil))
  801.  
  802. (energize-set-default-menubar)
  803.  
  804.  
  805. ;; enable purify & plain dbx by default
  806. ;; you can enable the others by copying to .emacs and uncommenting ...
  807. ;; can't do this here because this file comes preloaded.
  808.  
  809. (energize-define-instrumentatarget-using-tool "")
  810. (energize-define-instrumentatarget-using-tool "purify")
  811. ;; (energize-define-instrumentatarget-using-tool "quantify")
  812. ;; (energize-define-instrumentatarget-using-tool "sentinel")
  813. ;; (energize-define-instrumentatarget-using-tool "tc")
  814. ;; (energize-define-instrumentatarget-using-tool "time")
  815. ;; (energize-define-instrumentatarget-using-tool "xproba")
  816.  
  817. ;; add the menu item Help->About Energize for the Energize Welcome Mat
  818. (add-menu-item '("Help") (purecopy "About Energize")
  819.            'energize-about-energize t)
  820.  
  821. (defun energize-about-energize ()
  822.   (interactive)
  823.   (start-process "about-energize" nil "about_energize"))
  824.  
  825. (defun energize-kill-server ()
  826.   "Kill the Energize server and all buffers associated with it."
  827.   (interactive)
  828.   (condition-case nil
  829.       (energize-execute-command "energizeShutdownServer")
  830.     (error nil)))
  831.  
  832. (defun energize-unix-manual ()
  833.   "Display a manual entry; if connected to Energize, uses the Energize version.
  834. Otherwise, just runs the normal emacs `manual-entry' command."
  835.   (interactive)
  836.   (if (connected-to-energize-p)
  837.       (energize-execute-command "manual")
  838.     (call-interactively 'manual-entry)))
  839.  
  840. ;;; These functions are used in the menubar activate hook to update the
  841. ;;; enable state of the menu items
  842.  
  843. (defvar active-items) ; quiet compiler
  844. (defsubst activate-energize-menu-item-internal (item)
  845.   (cond
  846.    ((vectorp item)
  847.     (let ((fn (aref item 1)))
  848.       (if (not (and (symbolp fn) (get fn 'energize-name)))
  849.       nil
  850.     ;; Referencing special binding of `active-items' from a-e-m-i-hook.
  851.     ;; If the function which this item invokes is an Energize function
  852.     ;; (determined by the presence of an 'energize-name property) then
  853.     ;; make it be active iff it's on the active-items list.
  854.     (let ((active-p (assq fn active-items))
  855.           (change-p nil))
  856.       (if (not (eq (not active-p) (not (aref item 2))))
  857.           (progn
  858.         (aset item 2 (not (not active-p)))
  859.         (setq change-p t)))
  860.       (if (and active-p
  861.            (not (equal (cdr active-p)
  862.                    (if (> (length item) 3)
  863.                    (aref item 3)
  864.                  nil))))
  865.           (progn
  866.         (aset item 3 (cdr active-p))
  867.         (setq change-p t)))
  868.       change-p))))
  869.    ((consp item)            ; descend nested submenus
  870.     (activate-energize-menu-items-internal (cdr item)))
  871.    (t nil)))
  872.  
  873. (defun activate-energize-menu-items-internal (items)
  874.   (let ((change-p nil))
  875.     (if (not (consp items))
  876.     (activate-energize-menu-item-internal items)
  877.       (while items
  878.     (setq change-p (or (activate-energize-menu-item-internal (car items))
  879.                change-p)
  880.           items (cdr items)))
  881.       change-p)))
  882.  
  883. (defun energize-build-menubar-names ()
  884.   ;;; makes the list of currently active menu items.
  885.   (let* ((selection-p (x-selection-exists-p 'PRIMARY))
  886.      (menubar
  887.       (if (< (cdr (energize-protocol-level)) 7)
  888.           (energize-with-timeout
  889.            "Getting updated menubar from Energize server..."
  890.            (energize-list-menu (current-buffer) () selection-p))
  891.         (append energize-menu-state energize-default-menu-state))))
  892.     (delq nil
  893.       (mapcar '(lambda (x)
  894.              (and (vectorp x)
  895.               (if (/= 0 (logand 1 (aref x 3)))
  896.                   nil
  897.                 (cons
  898.                  (symbol-value
  899.                   (intern-soft (aref x 0)
  900.                        energize-menu-item-table))
  901.                  (aref x 4)))))
  902.           menubar))))
  903.  
  904. (defun activate-energize-menu-items-hook ()
  905.   ;; This is O^2 because of the `rassq', but it looks like the elisp part
  906.   ;; of it only takes .03 seconds.  
  907.   (if (connected-to-energize-p)
  908.       (let* ((items current-menubar)
  909.          (change-p nil)
  910.          ;; dynamically used by activate-energize-menu-item-internal
  911.          (active-items (energize-build-menubar-names))
  912.          item)
  913.     (while items
  914.       (setq item (car items)
  915.         change-p (or (and item (activate-energize-menu-items-internal
  916.                     (if (consp item) (cdr item) item)))
  917.                  change-p)
  918.         items (cdr items)))
  919.     (not change-p))))
  920.  
  921. (add-hook 'activate-menubar-hook 'activate-energize-menu-items-hook t)
  922.  
  923. (defun deactivate-all-energize-menu-items ()
  924.   (let ((items current-menubar)
  925.     ;; dynamically used by activate-energize-menu-item-internal
  926.     (active-items nil)
  927.     item)
  928.     (while items
  929.       (if (setq item (car items))
  930.       (activate-energize-menu-items-internal
  931.        (if (consp item) (cdr item) item)))
  932.       (setq items (cdr items)))))
  933.  
  934.  
  935. ;;; The Options menu
  936.  
  937. (setq options-menu-saved-forms
  938.       (purecopy
  939.        (append
  940.     options-menu-saved-forms
  941.     '((list 'energize-set-edit-modes
  942.         (if energize-external-editor
  943.             (symbol-name energize-external-editor))
  944.         (list 'quote energize-vi-terminal-emulator)
  945.         (list 'quote energize-internal-viewer)
  946.         (list 'quote energize-internal-editor)
  947.         (cond ((get 'browser 'instance-limit) ''multi)
  948.               ((get 'energize-top-level-mode 'screen-name)
  949.                ''several)
  950.               (t ''single))
  951.         (list 'quote energize-split-screens-p)
  952.         )
  953.       (if sc-mode
  954.           (list 'sc-mode (list 'quote sc-mode))
  955.         '(if (featurep 'generic-sc) (sc-mode nil)))
  956.       ))))
  957.  
  958.  
  959. ;;; Popup-menus
  960.  
  961. (defvar energize-popup-menu)
  962.  
  963. (defvar energize-hack-popup-hook '()
  964.   "Hook for all functions that want to hack at the Energize popup menus.
  965. Each function takes two arguments: an extent (or nil if none) and a menu
  966. (or nil if none currently). It should return a menu (or nil)")
  967.  
  968. (defun energize-popup-menu (event)
  969.   (interactive "e")
  970.   (if (popup-menu-up-p)
  971.       ()
  972.     (if (null (event-over-text-area-p event))
  973.     ;; clicking in non-text areas was causing errors...way bogus!
  974.     (popup-mode-menu)
  975.       (let* ((buffer (event-buffer event))
  976.          (extent (if (extentp (event-glyph-extent event))
  977.              (event-glyph-extent event)
  978.                (energize-menu-extent-at (event-point event) buffer)))
  979.          choices)
  980.     (select-window (event-window event))
  981.     (if extent
  982.         (progn
  983.           (energize-with-timeout
  984.            "Asking Energize server for menu contents..."
  985.            (setq choices
  986.              (cdr
  987.               (cdr
  988.                (energize-list-menu buffer extent
  989.                        (x-selection-exists-p 'PRIMARY))))))))
  990.     (if (or (null extent) (null choices))
  991.         (if (null (setq energize-popup-menu
  992.                 (energize-extent-run-hook energize-hack-popup-hook
  993.                               nil nil)))
  994.         (error "No menu to pop up"))
  995.       (force-highlight-extent extent t)
  996.       (sit-for 0)
  997.       (setq energize-popup-menu
  998.         (cons "energizePopup"
  999.               (mapcar
  1000.                (function (lambda (item)
  1001.                    (vector
  1002.                     (aref item 0)
  1003.                     (list 'energize-execute-command
  1004.                       (aref item 0)
  1005.                       extent)
  1006.                     (= 0 (logand 1 (aref item 3)))
  1007.                     (aref item 4))))
  1008.                choices)))
  1009.       (setq energize-popup-menu
  1010.         (external-editor-hack-popup
  1011.          (energize-extent-run-hook energize-hack-popup-hook
  1012.                        extent energize-popup-menu))))
  1013.     (if (equal (car energize-popup-menu) "energizePopup")
  1014.         (let ((popup-menu-titles nil))
  1015.           (popup-menu 'energize-popup-menu))
  1016.       (popup-menu 'energize-popup-menu))))))
  1017.  
  1018. (defun energize-extent-run-hook (f ex m)
  1019.   (if f
  1020.       (energize-extent-run-hook (cdr f) ex (funcall (car f) ex m))
  1021.     m))
  1022.  
  1023. ;;; Functions to interactively execute menu items by their names.
  1024.  
  1025. (defun energize-menu-extent-at (pos buffer)
  1026.   (if (null pos)
  1027.       nil
  1028.     (let ((extent (energize-extent-at pos buffer)))
  1029.       (if (and extent (energize-extent-menu-p extent))
  1030.       extent
  1031.     nil))))
  1032.  
  1033. ;;; functions to execute the menu with the keyboard
  1034. (defun default-selection-value-for-item (menu-item)
  1035.   (let ((flags (aref menu-item 3)))
  1036.     (cond ((= (logand flags 2) 2)
  1037.        (if (x-selection-owner-p 'PRIMARY)
  1038.            (x-get-selection-internal 'PRIMARY 'STRING)))
  1039.       ((= (logand flags 4) 4)
  1040.        (if (x-selection-owner-p 'PRIMARY)
  1041.            (x-get-selection-internal 'PRIMARY 'ENERGIZE_OBJECT)))
  1042.       ((= (logand flags 128) 128)
  1043.        (if (x-selection-owner-p 'SECONDARY)
  1044.            (x-get-selection-internal 'SECONDARY 'STRING)))
  1045.       ((= (logand flags 256) 256)
  1046.        (if (x-selection-owner-p 'SECONDARY)
  1047.            (x-get-selection-internal 'SECONDARY 'ENERGIZE_OBJECT))))))
  1048.   
  1049. (defun energize-execute-menu-item-with-selection (buffer
  1050.                           extent
  1051.                           item
  1052.                           selection
  1053.                           no-confirm)
  1054.   (if (/= 0 (logand 1 (aref item 3)))
  1055.       (error "The `%s' command is inappropriate in this context"
  1056.          (aref item 0)))
  1057.   (if (null selection)
  1058.       (setq selection (default-selection-value-for-item item)))
  1059.   (energize-execute-menu-item buffer extent item selection no-confirm))
  1060.  
  1061. (defun energize-find-item (name list)
  1062.   (let ((l list) i (found ()))
  1063.     (while (and l (not found))
  1064.       (setq i (car l) l (cdr l))
  1065.       (if (and (vectorp i) (equal (aref i 0) name))
  1066.       (setq found i)))
  1067.     found))
  1068.  
  1069. (defun energize-menu-item-for-name (extent name)
  1070.   (if (or extent (< (cdr (energize-protocol-level)) 7))
  1071.       (energize-with-timeout
  1072.        "Checking Energize command with kernel..."
  1073.        (energize-list-menu (current-buffer) extent
  1074.                (x-selection-exists-p 'PRIMARY) name))
  1075.     (or (energize-find-item name energize-menu-state)
  1076.     (energize-find-item name energize-default-menu-state))))
  1077.  
  1078. (defun energize-execute-command (name &optional extent selection no-confirm)
  1079.   ;; add completion here...
  1080.   (interactive "sExecute Energize command named: ")
  1081.  
  1082.   (if (not (stringp name))
  1083.       (error "Can't execute a choice, %s, that is not a string" name))
  1084.  
  1085.   (or (connected-to-energize-p) (error "Not connected to Energize"))
  1086.  
  1087.   ;; patch the selection argument for "setbreakpoint"
  1088.   (if (and (equal name "setbreakpoint")
  1089.        (null selection))
  1090.       (setq selection
  1091.         (save-excursion
  1092.           (vector (energize-buffer-id (current-buffer))
  1093.               (progn (beginning-of-line)
  1094.                  (energize-file-position (point))))
  1095.               (progn (end-of-line)
  1096.                  (energize-file-position (point))))))
  1097.   (let* ((buffer (current-buffer))
  1098.      (extent (if extent
  1099.              (if (extentp extent)
  1100.              extent
  1101.                (energize-menu-extent-at (point) buffer))
  1102.            nil)))
  1103.     (if (< (cdr (energize-protocol-level)) 7)
  1104.     ;; old way
  1105.     (let ((item (energize-menu-item-for-name extent name)))
  1106.       (if (not item)
  1107.           (error "No Energize command named %s" name))
  1108.       (energize-execute-menu-item-with-selection buffer extent item
  1109.                              selection no-confirm))
  1110.       ;; new way
  1111.       (if (and (null selection)
  1112.            (x-selection-exists-p 'PRIMARY))
  1113.       (setq selection
  1114.         (condition-case
  1115.             ()
  1116.             (x-get-selection-internal 'PRIMARY 'STRING)
  1117.           (error ""))))
  1118.       (let ((energize-make-many-buffers-visible-should-enqueue-event
  1119.          (equal name "save")))
  1120.     (energize-execute-command-internal buffer
  1121.                        extent
  1122.                        name
  1123.                        selection
  1124.                        no-confirm)))))
  1125.  
  1126.  
  1127.  
  1128. ;;; Buffer modified the first time hook
  1129. ;;; Should be in energize-init.el but is here to benefit from the 
  1130. ;;; add-timeout macro  
  1131.  
  1132. (defun energize-check-if-buffer-locked ()
  1133.   (if (connected-to-energize-p)
  1134.       (energize-with-timeout
  1135.        "Asking Energize server if buffer is editable..."
  1136.        (energize-barf-if-buffer-locked))))
  1137.  
  1138. (add-hook 'first-change-hook 'energize-check-if-buffer-locked)
  1139.  
  1140.  
  1141. ;;; Here's a converter that makes emacs understand how to convert to
  1142. ;;; selections of type ENERGIZE.  Eventually the Energize server won't
  1143. ;;; be using the selection mechanism any more, I hope.
  1144.  
  1145. (defun xselect-convert-to-energize (selection type value)
  1146.   (let (str id start end tmp)
  1147.     (cond ((and (consp value)
  1148.         (markerp (car value))
  1149.         (markerp (cdr value)))
  1150.        (setq id (energize-buffer-id (marker-buffer (car value)))
  1151.          start (1- (marker-position (car value)))  ; zero based
  1152.          end (1- (marker-position (cdr value)))))
  1153.       ((extentp value)
  1154.        (setq id (extent-to-generic-id value)
  1155.          start 0
  1156.          end 0)))
  1157.     (if (null id)
  1158.     nil
  1159.       (setq str (make-string 12 0))
  1160.       (if (< end start) (setq tmp start start end end tmp))
  1161.       (aset str 0 (logand (ash (car id) -8) 255))
  1162.       (aset str 1 (logand (car id) 255))
  1163.       (aset str 2 (logand (ash (cdr id) -8) 255))
  1164.       (aset str 3 (logand (cdr id) 255))
  1165.       (aset str 4 (logand (ash start -24) 255))
  1166.       (aset str 5 (logand (ash start -16) 255))
  1167.       (aset str 6 (logand (ash start -8) 255))
  1168.       (aset str 7 (logand start 255))
  1169.       (aset str 8 (logand (ash end -24) 255))
  1170.       (aset str 9 (logand (ash end -16) 255))
  1171.       (aset str 10 (logand (ash end -8) 255))
  1172.       (aset str 11 (logand end 255))
  1173.       (cons 'ENERGIZE_OBJECT str))))
  1174.  
  1175.  
  1176. (or (assq 'ENERGIZE_OBJECT selection-converter-alist)
  1177.     (setq selection-converter-alist
  1178.       (cons '(ENERGIZE_OBJECT . xselect-convert-to-energize)
  1179.         selection-converter-alist)))
  1180.  
  1181.  
  1182. ;;; Function keys.
  1183.  
  1184. (defun energize-define-function-keys ()
  1185.   "Define some Borland/Motif-like `F' keys for Energize."
  1186.   (define-key global-map 'f1 'help-for-help)
  1187.   (define-key global-map 'f3 'energize-search)
  1188.   (define-key global-map '(shift delete) 'x-kill-primary-selection)
  1189.   (define-key global-map '(control insert) 'x-copy-primary-selection)
  1190.   (define-key global-map '(shift insert) 'x-yank-clipboard-selection)
  1191.   (define-key global-map '(control delete) 'x-delete-primary-selection)
  1192.  
  1193.   (define-key global-map 'f7 'energize-browse-error)
  1194.   (define-key global-map '(meta f7) 'next-error)
  1195.   (define-key global-map '(meta f8) 'previous-error)
  1196.  
  1197.   (define-key global-map 'f9 'energize-build-a-target)
  1198.   (define-key global-map '(meta f9) 'energize-default-compile-file)
  1199.   (define-key global-map '(control f9) 'energize-run-target)
  1200.   (define-key global-map '(meta shift f9) 'energize-abort-build)
  1201.  
  1202.   (define-key global-map '(meta control ?.) 'energize-edit-declaration-dbox)
  1203.   (define-key global-map 'f5 'energize-browse-language-elt)
  1204.   (define-key global-map '(shift f5) 'energize-next-use-start)
  1205.   (define-key global-map '(control f5) 'energize-next-use-command)
  1206.   )
  1207.  
  1208.